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FF 00 00 RR RR UU UU NNNN NN DD DD EE RR RR FF 
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FORSUNDERF = Fortran underflow exception handle 16-Sep-1984 00:56: AX-11 Bliss-32 V4.0-74 p 
. 12-808= 1382 99:38:98 FORRTL RCIFORUNDERF .B 2;1 ~~ a} 


| 
~~ 
a 


3 1 001 ZTITLE ‘FORSUNDERF = Fortran underflow exception handler’ 3 
oe 80 G 9 MODULE FORSUNDERF . _— nee! : 
ae 9003 [DENT = "1-003" ! File: FORUNDERF.B32 Edit: JAW1003 : 
ric 0005 1 BEGIN | ; 
; 6 006 1 !4+ 3 
3 7 Nika 1! 3 
8 3 $8 : , Seeeeenneneeanerenneneerenearereerereceereeeeertererennnenennenteteenteetete | 3 
3 '® * 3 
> gpl 1 !® COPYRIGHT (c) 1978, 1980, 1982, 1984 BY ® 3 
> 14 011 1 i DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. . : 
: 1g OO1g 1 is ALL RIGHTS RESERVED. , ; 
i | 0014 1 i® THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * : 
3 15 0015 1 !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * > 
ec), B28 1 !® INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * 3 
: 17 001 1 !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ® ; 
H 18 0018 1 !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * ; 
: 1 sith : . TRANSFERRED. . : 
: 21 0021 1 Is THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * | : 
3 22 00 § 1 !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * $ 
; $ 99 ; ! i? CORPORATION. . | : 
: 25 on5¢ 1 ie DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS # ; 
H $$ 534 : SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * 3 
! # 3 
: a 0028 1 !* * s 
3 $0 94 ’ | SeeeennnennncenenseneeassesesonaenorenensesonenesegongonesonsceneeneosoneetS Py 
: 31 0031 1: | ; 
: % 0035 ' FACILITY: Fortran Support Library : 
> 34 0034 1 | ABSTRACT: ; 
; * 0035 1! 3 
; 0036 1! This module contains a condition handler for floating underflow : 
s SV 0037 1! exceptions and an exit handler to report the number of underflow : 
: $ sits : exceptions at image exit. : 
; re re : ENVIRONMENT: Runs at any access mode - AST reentrant 3 
; 42 0042 i AUTHOR: John A, Wheeler, CREATION DATE: 21-Aug-1981 ; 
i 4h 44 1 | MODIFIED BY: | : 
> 46 04g i 1-001 - Original. JAW 21-Augo1981 | ; 
3; (47 047 1 ! 1-002 = Remove address of UNDERFLOW_COUNT from exit control block, as ; 
; 48 ppee 1! count is now referenced directly. Remove unused external | F 
; «649 0049 1! reference to 1° TCH COND. J aren : 
; + 50 1 ! 1-003 = Change name of FORSHANDLER to FORSUNDER LOW_HANDLER. Give the : 
re. te Ja threshold value a non-public name. Include sever ty in | 3 
; 26 26 1! condition check to preclude c nting the same exception twice | : 
: 34 0084 ! at more than one level. JAW 29-Aug-1981 : 
: 55 55 17 | : 
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3 
ee pee 5 ris Fortran underflow exception handle 18-Sep-1984 90:38:08 arate sar tron v4.0- 


FORRTL. 


4SBTTL ‘Declarations’ 
SWITCHES: 


SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
' 


; LINKAGES: 

NONE 

TABLE OF CONTENTS: 
FORWARD ROUTINE 


FORSUNDERF LOW_HANDLER 
EXIT_HANDLER = NOVALUE; 


; INCLUDE FILES: 


LIBRARY *RTLSTARLE'; 

REQUIRE ‘RTLML:FORMSG’; 
REQUIRE 'RTLML:OTSMSG'; 
REQUIRE ‘RTLML:MTHMSG'; 


REQUIRE ‘RTLIN:RTLPSECT'; ! Define PSECT declaration macros 


' 
MACROS: 
NONE 
EQUATED SYMBOLS: 
LITERAL 
K_UNDERFLOW_THRESHOLD = 2; ! Message-printing threshold 
FIELDS: 
NONE 
PSECTS: 
Specify page alignment (9) for the OWN psect, so that Gath LOCK 
will not occupy he same page as a user variable that is being 
WATCHed, and thus be unwriteable when SDCLEXH is called. 
DECLARE_PSECTS (FOR, 9); ! Declare PSECTs for FORS facility 


i OWN STORAGE: 


~~ 


FORUNDERF 


popreeN™ GeRtREg, 5 Fortren ntertu excpetonnanate Hise tats :S6HRE Heath SHES 


iz: 


OWN 
UNDERFLOW_COUNT : VOLATILE, : oo? of underflows which hav 
i occurred (and have reached FORSUNDERFLOW. HANDLER) 
EXIT_HNDLR_LOCK : INITIAL (0) ! Flag indicating whether exit 
QoLATICE; i handler has been declared yet 


EXTERNAL REFERENCES: 


EXTERNAL ROUTINE 
LIBSSIM_ TRAP, 
LIBSSIGRA AL. 
LIBSSTOP; 


Se Se Oe Oe Oe Oe Se Se ee Oe Oe Ge BH FH Se ae 
et os a tn ts ts I I SS 
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FORSUNDERF = Fortran underflow exception handle 1o~sen~ 138% 90:38:08 AX-11 tH V4.0-74 
Declarations 14-Sep-1984 12:32: FORRTL.SRCJFORUNDERF .B52;1 (3). 


re 


'¢ 

! If the exception is any form of floating underflow (fault, trap or 
! math Library condition), count it, print a message if not yet over 
: the Limit, and continue. 


1 GLOBAL ROUTINE FORSUNDERFLOW_HANDLER ( ! FORTRAN floating underflow handler 

SIG_ARGS_ADR, ! Address of signal array 

MCH_ARGS_ADR, ! Address of mechanism array 

ENB_ARGS ' Address of enable array 

= ! A handler always has a value 
BEGIN 
MAP 

4 SIG_ARGS_ADR : REF BLOCK f BYTE], 
4 MCH_ARGS_ADR : REF BLOCK [, BYTEJ, 
4 ENB-ARGS_ADR : REF VECTOR; 
4 
Z EXIT_REASON, ! Reason for image exit (not used) 
4 EXIT_BLOCK : VECTOR [4] INITIAL ! Exit control block for SDCLEXH 
4 TO, ! “Forward Link (filled in by VMS) 
4 0, ! Exit handler address 
5 2. ! Number of arguments to exit handler 
2 0); ! Address of EXIT_REASON 
5 OCAL 
5 DCLEXH_STATUS, ' Result of SDCLEXH 
: AST_STATUS; ! Result of SSETAST 
5 | 
5 
5 
6 
6 
6 
6 


IF (.SIG_ARGS_ADR CCHFSL_SIG_NAME] AND (S 
ane (SSS_FLTUND_F AND (S 


I | 
, A fault. | 


i Convert the fault to a trap. Control will not return from 
: LIBSSIM_TRAP; rather, a new exception (a trap) will occur. 


TSSM_COND_ID OR STSSM_SEVERI 
TSSM~COND-ID OR S 


a TY)) EQL 
R STSSM_SEVERITY)) 


LIBSSIM_TRAP (.SIG_ARGS_ADR, .MCH_ARGS_ADR) 


MEFUR 0 OD NOU EWN 9 ODNA UENO OD NAME WN CO OONOU Et" OOM 


Cc 
4 

: 
085 
55 
82? 
56 
056 
056 
056 
056 
056 
056 
056 
056 
056 
057 
057 
057 
057 
057 
057 
057 
057 
057 
057 
058 
058 
058 
058 
058 
058 
058 
058 
058 
058 
059 
$29 
59 
059 
059 
059 


i a rE aS a TE a a a 
00 00 0D ONIN NANO o 


Be Be Oe Be Oe Oe Oe Oe Se Se BH Se Ge Oe Oe Se Se SESH SETH Oe He Be SHH Se Oe Se SESH Se Be OH SH Se Se HE Se Se SESE SESH Se Se Se Se Se Ge Geass sess sees 


PAA API AIGEPI AI PIPIPYPIPIPIPYPDNYPYNYDI LAPUPIPYRIPYNINIPYPINPIPIPIPINIPINIPIPINIPININPINININININ 2 


ELSE 
IF ((.SIG_ARGS_ADR CCHFSL_SIG_NAME] AND (STSS$M_COND_ID OR STSSM_SEVERITY)) EQL 
if on (SS$_FLTUND AND (STSS$M_COND_ID OR STSSM_SEVERITY))) | 
0899 ((,S1G_ARGS_ADR CCHFSL_SIG_ NAME] AND (STSSM_COND_ID OR STSSM_SEVERITY)) EQL | 
0598 (MTHS_FLOONDMAT AND (STSSM_COND_ID OR STSSM_SEVERITY))) 
0599 THEN 
Reno BEGIN 
eit) ‘+ : aaa 
0 ' A trap or math Library condition. 
87 04 : 


3 
PORSUMDERE FORSUNDERF = Fortran underflow exception handle 16-5e -1984 00:56: AX-11 Bliss-32 V4.0-74 Page 5. 
1-00 Declarations . 1 ~300 71382 99:35:93 FORRTL.SRCJFORUNDERF .852;1 . (3) | 
H 188 605 : Count the underflow. Then check EXIT_HNDLR_LOCK to see 
: 189 one ! whether the exit handler has been declared res (1 = yes. 
; 190 6 ! 0 = maybe). If maybe, disable ASTs and recheck. This 
> #191 08 ! assures that the exit handler will be declared only once 
3 135 609 ' even if underflows occur at AST level. 
me Bi 4 
: 195 O61¢ UNDERFLOW_COUNT = .UNDERFLOW_COUNT + 1; | 
: 197 0614 IF NOT .EXIT_HNDLR_LOCK | 
: 198 Sele THEN BEGIN | 
: 200 $ei8 4 AST STATUS = $SETAST (ENBFLG = 0); 
; 201 0618 4 1F Rot EXIT_HNDLR_LOCK | 
: 208 0620 5 BEGIN 
me ORES ' 
> 206 06 g 5 i FILL in the exit control block (at run time, to | 
s gor 0624 5§ ! keep it position-independent), declare the exit 
; 208 0625 5 ' handler, and set the lock. | 
Ros Bt ‘ 
: 211 0628 5 EXIT_BLOCK [1] = EXIT_HANDLER; | 
3 si¢ +234 5 EXIT BLOCK (3) = EXIT "REASON; 
: i 0630 5 DCLERH STATUS = SDCLERH (DESBLK = EXIT_BLOCK); 
> 214 0631 5 EXIT_HNDLR_LOCK = 1 | 
eke t st 
; giz 0634 4 DCLEXH_STATUS = 1; 
: 219 0636 4 IF .AST_STATUS EQL SS$_WASSET THEN SSETAST (ENBFLG = 1); | 
: 221 0638 4 IF NOT .DCLEXH_STATUS THEN LIBSSTOP (OTSS$_FATINTERR) ELSE 1 | 
> 222 0639 END; | 
; $$2 pee? 2 | 
; $6 064 ; i If the number of underflows does not yet exceed the | 
; 226 064 ! message threshold, change the sever {t7 of the condition to | 
We 46 0644 ; ' ERROR and resignal it so the catch-all handler will print 
3 209 Reet a message and continue. Otherwise just continue. | 
: 230 0647 ; 
; Ht 3 ak ren Soe LEQ K_UNDERFLOW_THRESHOLD 
: 3§ 0630 4 BEGIN 
: 34 651 4 BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAME], STS$SV_SEVERITY; , BYTE] = STSSK_ERROR; 
s 235 0626 4 RETURN SS$_RESIGNAL 
; 3$ beea : ise’ 
: 238 Tt} RETURN SS$_CONTINUE 
: 39 2$ D 
: 240 65 
g . $28 ELSE 
; t§ 60 '¢ 
: 266 0661 ! Resignal the exception, since it is not an underflow. 


- 3 | 
FORSUNDERF FORSUNDERF = Fortran underflow exception handle 16-Sep-1984 00:56: AX-11 Bliss-32 V4.0-74 P 6 
ets Declarations , 182860=1 382 99:35:93 FORRTL.SRCJFORUNDERF .852;1 en (3). 
; 245 066 le 
; 24 066 
: re ee) RETURN SS$_RESIGNAL 
: 249 0666 1 END; ! End of routine FORSUNDERFLOW_HANDLER 


-TITLE FORSUNDERF FORSUNDERF - Fortran underflow excep 
s tion handle 

-IDENT \1=-003\ 

-PSECT _FORSDATA,NOEXE, PIC,9 


00000 UNDERFLOW COUNT: 


| 
| 
-BLKB 4 
00000000 00004 EXIT_HNDLR_ LOCK: 

-LONG O ; 
00008 EXIT_REASON: | : | 

00000000 00000002 00000000 00000000 0000C EXIT_BLOCK: 
<LONG 0, 0, 2, 0 : 
EXTRN LIBSSIM_TRAP, LIBSSIGNAL | 
EXTRN LIBS$STOP, SYSSSETAST 

EXTRN SYSSDCLEXH | 


-PSECT _FORSCODE,NOWRT, SHR, PIC,2 


007¢ 00000 .ENTRY FORSUNDERFLOW_HANDLER, Save R2,R3,R4,R5,R6 ; 0548 
56 000000006 00 9E 00002 MOVAB SYSSSETAST, : 
55 00000000° EF 9 00009 MOVAB EXIT_HNDLR-LOCK, R5 F 
52 04 AC 00 00010 MOVL § SIG_ARGS_ADR, R : 0580 
000004C4 8F 04 A2 iC 00 ED 00014 CMPZ2V #0,7#28,-4(R2), #1220 : 0581 
OD 12 OOO1E BNEQ : 
08 AC DD 90020 PUSHL MCH_ARGS_ADR > 0591 
38 DD 000 PUSHL Re ; 
000000006 00 0 FB 00 3 CALLS #2, LIBSSIM_TRAP : 
0000049 BF 04 A2 1C 00 ED 00 : 1$: CHPZV #0, #28, 4(R2), #1180 : 0595 
001682cC = BF 04 A2 1¢ 00 ED 90 9 CMPZ7V #0, #28, 4(R2), #1475276 : 0598 
5D 12 0043 BNEQ =s«B ; 
FC OAS 06 0045 2$: INCL | UNDERFLOW_COUNT > 0612 
45 $3 E ones BLBS EXIT_HNDLR_LOCK, 6$ ; 061 
E D4 0004B CLRL (SPY : 0617 
66 gi FB 99040 CALLS #1, SYSSSETAST ; 
54 Q 00 9090 OVL RO. AST STATUS : 
1D 6 05 BLBS  EXIT_HNBLR_LOCK, 38 : 0618 
Oc AS O000v CF 9E 096 MOVAB EXITHANDLER, EXIT BLOCK+4 : 0628 
14 AS 4 AS E 0005¢ MOVAB EXITREASON, EXIT_BLOCK+12 + 0629 
8 aS OF 061 PUSHAB EXIT BLOCK > 0630 
000000006 Q gi FB 64 CALLS #1, SYSSDCLEXH ; 
0 D 068 MOVL RO, DCLEXH_ STATUS ; 
6 } b0 ¢f mOVL a, EXIT_HROLR_LOCK ; 0631 
53 1 00 Or 3$: MOVL #1, DCLEXH_STATUS ; 06 
09 4 01 00076 4$: CMPL  AST_STATUS? #9 ; 06 


FORSUNDERF FORSUNDERF = Fortran underflow exception handle 18-se =| AX-11 Bliss-32 V4.0-74 
1 ofOS Declarations : Sep-1 7 99: 38: 9 AMARYL SRESFORUNDERF 64251 
. te 79 BNEQ 5$ 
1 0D 78 PUSHL #1 
6 } 4} 7 CALLS #1, SYSS$SETAST 
D E 5$: BLBS DCLEXH_STATUS, 6$ 
00178014 F DOD PUSHL #1540176 
000000006 + 1 FB 88 CALLS #1, LIBS$STOP 
9 FC AS 01 00090 6$: CMPL NDERFLOW_COUNT, #2 
08 14 00094 BGTR $ 
046 A2 03 00 02 FO 00096 INSV #2, #0, #3, 4(R2) 
04 11 0009C BRB 8$ 
50 01 00 OOO9E 7$: MOVL #1, RO 
Of Rapa RET 
50 0918 8F 3C Bahs 8$: MOVZ2WL #2328, RO 
04 OOOA RET 


; Routine Size: 168 bytes, Routine Base: _FORSCODE + 0000 


Be Se Se Be Be Be Se Se Se Se Se Be Be Be 


o oo 
$ an 

ww 
*- we 


— 


ry 667 


PIR TRISTE IO ISTE TEETER 
wi 
co 
[=] 
COON NNN NNN NNO OO 
—OCONOULS WN —O0OM@ 


; 266 pene 
: 267 068 
; 268 0684 
: Name 

> _FORSDATA 

; —FORSCODE 


4 3 | 
FORSUNDERF FORSUNDERF = Fortran underflow exception handle 16-Sep-1984 256: AX-11 Bliss-32 V4.0-74 P 
et 5 Declarations . 1a-sep-19 4 99:35:98 RC} F.B52;1 -_ 


Se ~ _ —_ — 


FORRTL. FORUNDER 


1 ROUTINE EXIT_HANDLER ( 
EX1T “REASON 


| 
1 
1 ) : NOVACUE = 
BEGIN 
ts | 
! Cause a message containing the total number of underflows to be 
printed if nonzero. The severity is STSSK_INFO = 3 = INFORMATION. | 
IF zUDERF LEMONT GTR 0 

LIBSSIGNAL (FORS_FLOUNDEXC, 1, .UNDERFLOW_ COUNT); | 

1 END; ! End of routine EXIT_HANDLER 


0004 00000 EXIT_HANDLER: 
- WORD 


Save R2 3; 0667 
52 00000000' EF 9€ 00002 MOVAB UNDERFLOW_COUNT, R2 : 
62 D5 00009 TSTL UNDERFLOW_ COUNT ; 0677 
11 15 00008 BLEQ 3 
62 DD 00000 PUSHL UNDERFLOW_COUNT 3; 0679 
01 DD OO00F PUSHL 3 
00188963 8F DD 00011 PUSHL #1608035 3 
00000000G 00 03 FB 00017 CALLS #3, LIBSSIGNAL : 
04 OOO1E 1$: RET ; 0681 


Routine Size: 51 bytes, Routine Base: _FORSCODE + O0A8 


1 
1E 


ND ! End of module FORSUNDERF 
0 ELUDOM 


PSECT SUMMARY 

Bytes Attributes 
28 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON, PIC,ALIGN(9) 
199 NOVEC,NOWRT, RD, €XE, SHR, LCL, REL, CON, PIC,ALIGN(2) 


Library Statistics 


FORSUNDERF FORSUNDERF = fortran underflow exception handle 1b-se ep- 1384 90:36:08 = YAKeIT meses rag NpERr BS251 Page 


Declarations ep- 
! _$255$DUA28:CSYSLIBISTARLET.L3z;1 9776 14 0 581 00:01.0 
; COMMAND QUALIFIERS 
: PL TSS/CHECR OLY ELD. INITIAL OPT IAIZE) /NOTRACE/L IS. 158: FORUNDERT /08.)08.I5 1F ORUNDERF MSRC$:F ORUNDERF /UPDATE=(ENH$: F ORUNDERF 
3 pieces 199 code + 28 data bytes 
: Run Time 00:0 “ 
; hey Time: 00:25. 
3: Lines/CPU Min: 5668 
; Lonones/CPU-Ains 16218 
3 s 


pee’ | Used: 77 page 
a 


Compilation Complete 


T CORPORATION 
PROPRIETARY 


018 AH-BT13A-SE DIGI 
VAX/VMS V4.0 CONF 


